home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / util / text / megaed12.lha / MegaEdV1_2 / Trans / PCQ.trans.p < prev    next >
Text File  |  1992-09-02  |  3KB  |  139 lines
  1. PROGRAM PCQTrans;
  2.  
  3. {
  4.     Konvertiert PCQ-Fehlerdateien für MegaEd
  5.     von Wurzelsepp, 100% PD
  6. }
  7.  
  8. {$I "include:exec/memory.i" }
  9. {$I "include:libraries/dosextens.i" }
  10. {$I "include:utils/Stringlib.i" }
  11.  
  12. CONST
  13.     file1   :   String  =   "T:MegaEdMake-ErrFile";
  14.     file2   :   String  =   "T:MegaEdMake-Errors";
  15.     pc      :   String  =   "PCQ complete";
  16.     error   :   String  =   "E";
  17.     back    :   String  =   "/";
  18.     ret     :   Char    =   CHR(10);
  19.  
  20.     ver_text : String = "\0$VER: MegaEd-TransPCQ V1.01 (16.03.95)";
  21.  
  22. VAR
  23.     fileh       :   FileHandle;
  24.     meldung     :   BOOLEAN;
  25.     las,
  26.     len,
  27.     dummy       :   INTEGER;
  28.     old         :   Address;
  29.     off         :   ^Char;
  30.  
  31. PROCEDURE TickleOn;
  32.  
  33. BEGIN
  34.  Inc(las);
  35.  off:=Address(Integer(off)+1);
  36. END;
  37.  
  38. BEGIN
  39.  
  40.  IF DeleteFile(file2) THEN ;
  41.  
  42.  meldung:=FALSE;
  43.  fileh:=DOSOpen (file1,MODE_OLDFILE);
  44.  IF fileh<>NIL THEN
  45.  BEGIN
  46.   dummy:=Seek(fileh,0,OFFSET_END);
  47.   len:=Seek(fileh,0,OFFSET_BEGINNING);
  48.   if len>0 THEN
  49.   BEGIN
  50.    old:=AllocMem (len,MEMF_PUBLIC+MEMF_CLEAR);
  51.    IF old=NIL THEN
  52.    BEGIN
  53.     DOSClose (fileh);
  54.     Exit;
  55.    END;
  56.    IF DOSRead(fileh,old,len)<>len THEN
  57.    BEGIN
  58.     FreeMem(old,len);
  59.     DOSClose(fileh);
  60.     Exit;
  61.    END;
  62.   END;
  63.   DOSClose(fileh);
  64.   IF (len=0) THEN Exit;
  65.  
  66.   fileh:=DOSOpen (file2,MODE_NEWFILE);
  67.   IF fileh<>NIL THEN
  68.   BEGIN
  69.  
  70.    las:=0;
  71.    off:=old;
  72.    WHILE las<len DO
  73.    BEGIN
  74.     WHILE (off^<>'"') AND (las<len) DO
  75.      TickleOn;
  76.     IF las<len THEN
  77.     BEGIN
  78.      meldung:=TRUE;
  79.      TickleOn;
  80.      { Filename überlesen }
  81.      WHILE (off^<>'"') AND (las<len) DO
  82.       TickleOn;
  83.      IF las<len THEN
  84.      BEGIN
  85.       { 5 Zeichen (' " At ') überspringen }
  86.       FOR dummy:=1 TO 5 DO
  87.        TickleOn;
  88.       IF las<len THEN
  89.       BEGIN
  90.        dummy:=DOSWrite (fileh,error,StrLen(error));
  91.        WHILE (off^<>',') AND (las<len) DO
  92.        BEGIN
  93.         dummy:=DOSWrite (fileh,off,1);
  94.         TickleOn;
  95.        END;
  96.        IF las<len THEN
  97.        BEGIN
  98.         dummy:=DOSWrite (fileh,back,StrLen(back));
  99.         TickleOn;
  100.         WHILE (off^<>' ') AND (las<len) DO
  101.         BEGIN
  102.          dummy:=DOSWrite (fileh,off,1);
  103.          TickleOn;
  104.         END;
  105.         IF las<len THEN
  106.         BEGIN
  107.          dummy:=DOSWrite (fileh,Adr(ret),1);
  108.          { 3 Zeichen (' : ') überspringen }
  109.          FOR dummy:=1 TO 3 DO
  110.           TickleOn;
  111.          IF las<len THEN
  112.          BEGIN
  113.           WHILE (off^<>ret) AND (las<len) DO
  114.           BEGIN
  115.            dummy:=DOSWrite (fileh,off,1);
  116.            TickleOn;
  117.           END;
  118.           dummy:=DOSWrite (fileh,Adr(ret),1);
  119.           IF las<len THEN
  120.            TickleOn;
  121.          END;
  122.         END;
  123.        END;
  124.       END;
  125.      END;
  126.     END;
  127.    END;
  128.    DOSClose (fileh);
  129.   END;
  130.  
  131.   FreeMem(old,len);
  132.  
  133.  END;
  134.  
  135.  IF meldung=FALSE THEN
  136.   IF DeleteFile(file2) THEN ;
  137.  
  138. END.
  139.